home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / tclx7.5a- / tclx7 / usr / local / tkX / 4.1a-a2 / tk.tcl < prev    next >
Encoding:
Text File  |  1995-11-14  |  3.3 KB  |  111 lines
  1. # tk.tcl --
  2. #
  3. # Initialization script normally executed in the interpreter for each
  4. # Tk-based application.  Arranges class bindings for widgets.
  5. #
  6. # @(#) tk.tcl 1.74 95/10/04 15:51:46
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  
  14. # Insist on running with compatible versions of Tcl and Tk.
  15.  
  16. scan [info tclversion] "%d.%d" a b
  17. if {$a != 7} {
  18.     error "wrong version of Tcl loaded ([info tclversion]): need 7.x"
  19. }
  20. scan $tk_version "%d.%d" a b
  21. if {($a != 4) || ($b < 0)} {
  22.     error "wrong version of Tk loaded ($tk_version): need 4.x"
  23. }
  24. unset a b
  25.  
  26. # Add Tk's directory to the end of the auto-load search path:
  27.  
  28. lappend auto_path $tk_library
  29.  
  30. # Turn off strict Motif look and feel as a default.
  31.  
  32. set tk_strictMotif 0
  33.  
  34. # tkScreenChanged --
  35. # This procedure is invoked by the binding mechanism whenever the
  36. # "current" screen is changing.  The procedure does two things.
  37. # First, it uses "upvar" to make global variable "tkPriv" point at an
  38. # array variable that holds state for the current display.  Second,
  39. # it initializes the array if it didn't already exist.
  40. #
  41. # Arguments:
  42. # screen -        The name of the new screen.
  43.  
  44. proc tkScreenChanged screen {
  45.     set disp [file rootname $screen]
  46.     uplevel #0 upvar #0 tkPriv.$disp tkPriv
  47.     global tkPriv
  48.     if [info exists tkPriv] {
  49.     set tkPriv(screen) $screen
  50.     return
  51.     }
  52.     set tkPriv(afterId) {}
  53.     set tkPriv(buttons) 0
  54.     set tkPriv(buttonWindow) {}
  55.     set tkPriv(dragging) 0
  56.     set tkPriv(focus) {}
  57.     set tkPriv(grab) {}
  58.     set tkPriv(initPos) {}
  59.     set tkPriv(inMenubutton) {}
  60.     set tkPriv(listboxPrev) {}
  61.     set tkPriv(mouseMoved) 0
  62.     set tkPriv(oldGrab) {}
  63.     set tkPriv(popup) {}
  64.     set tkPriv(postedMb) {}
  65.     set tkPriv(pressX) 0
  66.     set tkPriv(pressY) 0
  67.     set tkPriv(screen) $screen
  68.     set tkPriv(selectMode) char
  69.     set tkPriv(window) {}
  70. }
  71.  
  72. # Do initial setup for tkPriv, so that it is always bound to something
  73. # (otherwise, if someone references it, it may get set to a non-upvar-ed
  74. # value, which will cause trouble later).
  75.  
  76. tkScreenChanged [winfo screen .]
  77.  
  78. # ----------------------------------------------------------------------
  79. # Read in files that define all of the class bindings.
  80. # ----------------------------------------------------------------------
  81.  
  82. catch {auto_load tkButtonEnter}
  83. catch {auto_load tkEntryButton1}
  84. catch {auto_load tkListboxMotion}
  85. catch {auto_load tkMbEnter}
  86. catch {auto_load tkScaleActivate}
  87. catch {auto_load tkScrollSelect}
  88. catch {auto_load tkTextButton1}
  89.  
  90. # ----------------------------------------------------------------------
  91. # Default bindings for keyboard traversal.
  92. # ----------------------------------------------------------------------
  93.  
  94. bind all <Tab> {focus [tk_focusNext %W]}
  95. bind all <Shift-Tab> {focus [tk_focusPrev %W]}
  96.  
  97. # tkCancelRepeat --
  98. # This procedure is invoked to cancel an auto-repeat action described
  99. # by tkPriv(afterId).  It's used by several widgets to auto-scroll
  100. # the widget when the mouse is dragged out of the widget with a
  101. # button pressed.
  102. #
  103. # Arguments:
  104. # None.
  105.  
  106. proc tkCancelRepeat {} {
  107.     global tkPriv
  108.     after cancel $tkPriv(afterId)
  109.     set tkPriv(afterId) {}
  110. }
  111.